 Loading |
|
Loading |
| VBScript |
| JavaScript |
| Powershell |
Search Options: 2008 Scripting Games Advanced VBScript Event 3
|
||
|
' This is my Solution for the Scripting Games 2008
' For more Information look at ' http://www.microsoft.com/technet/scriptcenter/funzone/games/games08.mspx Option Explicit Dim ofso : Set ofso = Createobject("Scripting.FileSystemObject") Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Dim Candidates() Dim CandidatesValues() ReDim Candidates(3) ReDim CandidatesValues(3) Candidates(0) = "Syed Abbas" Candidates(1) = "Ken Myer" Candidates(2) = "Jonathan Haas" Candidates(3) = "Pilar Ackerman" Dim CountVotes, iVotesPercent Dim arrVotesCalc() Dim Candidate_Array() Call Main() ' --------------------------------------- Sub Main() Dim arrVotes, iCount, iCount2, iChecks Dim arrTmpVotes, Remove_Candidate arrVotes = ReadFileToArray("C:\Scripts\votes.txt") If IsArray(arrVotes) then CountVotes = UBound(arrVotes) +1 iVotesPercent = CountVotes / 100 ReDim arrVotesCalc(UBound(arrVotes), 3) For iCount = 0 to UBound(arrVotes) If IsArray(arrTmpVotes) then Erase arrTmpVotes arrTmpVotes = Split(arrVotes(iCount), ",", -1, 1) For iCount2 = 0 to UBound(arrTmpVotes) arrVotesCalc(iCount,iCount2) = arrTmpVotes(iCount2) Next Next For iChecks = 1 to 3 Call GetVotes() If CheckWinner(CandidatesValues) = True then msgbox "The winner is " & Candidates(0) & " with " & _ CandidatesValues(0) & "% of the vote." Exit For Exit Sub Else Remove_Candidate = Candidates(Ubound(Candidates)) ReDim Preserve Candidates(Ubound(Candidates) -1) ReDim Preserve CandidatesValues(Ubound(CandidatesValues) -1) For iCount = 0 to Ubound(CandidatesValues) CandidatesValues(iCount) = 0 Next Call RemoveCandidateFromArray(arrVotesCalc, Remove_Candidate) End if Next End if End Sub ' --------------------------------------- Private Function ReadFileToArray(strFile) Dim strNextLine, arrstrList Dim arrLines() Dim iCount : iCount = 0 If ofso.FileExists(strFile) then Dim oFile : Set oFile = ofso.OpenTextFile(strFile, ForReading) Do Until oFile.AtEndOfStream Redim Preserve arrLines(iCount) arrLines(iCount) = oFile.ReadLine iCount = iCount + 1 Loop oFile.Close End if Set oFile = nothing If IsArray(arrLines) then ReadFileToArray = arrLines End Function ' --------------------------------------- Public Function GetVotes() Dim iCount, iCount2 For iCount = 0 to UBound(arrVotesCalc) For iCount2 = 0 to Ubound(Candidates) Select Case arrVotesCalc(iCount,0) Case Candidates(iCount2) CandidatesValues(iCount2) = CandidatesValues(iCount2) +1 End Select next Next For iCount = 0 to Ubound(CandidatesValues) CandidatesValues(iCount) = CandidatesValues(iCount) / iVotesPercent Next Call SortArrayDim2(CandidatesValues, "DESC") End Function ' --------------------------------------- Private Function SortArrayDim2(SourceArray, strSortTyp) Dim Sorted, iCount, Temp, Temp2 Sorted = False Do While Not Sorted Sorted = True For iCount = 0 To UBound(SourceArray) - 1 Select Case UCase(strSortTyp) Case "DESC" If UCase(SourceArray(iCount)) < UCase(SourceArray(iCount + 1)) Then Temp = SourceArray(iCount + 1) Temp2 = Candidates(iCount + 1) SourceArray(iCount + 1) = SourceArray(iCount) Candidates(iCount + 1) = Candidates(iCount) SourceArray(iCount) = Temp Candidates(iCount) = Temp2 Sorted = False End If End Select Next Loop End Function ' --------------------------------------- Private Function CheckWinner(SourceArray) If SourceArray(0) > 50 then CheckWinner = True Else CheckWinner = False End if End Function ' --------------------------------------- Private Function RemoveCandidateFromArray(SourceArray, strCandidate) Dim iCount For iCount = 0 to UBound(SourceArray) If SourceArray(iCount,0) = strCandidate then SourceArray(iCount,0) = SourceArray(iCount,1) SourceArray(iCount,1) = SourceArray(iCount,2) SourceArray(iCount,2) = SourceArray(iCount,3) SourceArray(iCount,3) = "" End if If SourceArray(iCount,1) = strCandidate then SourceArray(iCount,1) = "" If SourceArray(iCount,2) = strCandidate then SourceArray(iCount,2) = "" If SourceArray(iCount,3) = strCandidate then SourceArray(iCount,3) = "" Next End Function | ||
© 2008 - 2013 Boris Toll :: Scripts available: 6.481 :: :: scriptbox.toll.at :: :: powered by www.toll.at :: | ||
